1 Introduction
2 Loading library & data
- 2.1 Load libraries
3 Data Structure and Description
4 EDA(Exploratory Data Analysis)
5 Feature Engineering
6 Preparing data for modeling
- 6.1 Removing Outliers
- 6.2 preprocessing
7 Modeling
- 7.1 XGBoost
- 7.2 Ensemble

1 Introduction

설명과 첨언의 글이 많아 이후 경어는 생략하고 진행하겠습니다.

참조 1. https://www.kaggle.com/erikbruin/house-prices-lasso-xgboost-and-a-detailed-eda/report

캐글코리아 주최 2회째 Competition으로 주제는 House price prediction이다. 분석 언어는 ’R’을 쓰며, 주 패키지는 분석용 dplyr와 시각화 ggplot2이며, 이 두 패키지가 포함된 tidyverse를 쓸 예정이다. 교육 과정 제출용 포트폴리오이며, 참조한 커널은 링크를 첨부한다.

2 Loading library & data

2.1 Load libraries

library(tidyverse)   # ggplot2, dplyr, tidyr, tibble, readr 외 다양한 패키지가 있는 복합 패키지
library(corrplot)    # 시각화 사용(상관 계수 파악)
library(data.table)  # data Load
library(plotly)      # price 변수 인터랙티브 그래프 확인
library(scales)      # 그래프 축 수치 변경
library(gridExtra)   # 차트 멀티 표현
library(Rmisc)       # multiplot
library(zipcode)     # zipcode to city 변환
library(ggiraphExtra)# 지도 매핑 & 시각화
library(psych)       # Skewness
library(caret)       # preProcess
library(summarytools)# summary & 내용 개요
library(xgboost)     # xgboost model
library(tictoc)      # tic 함수

## Load Data

k_train <-  fread("./kako 2nd/train.csv")
k_test <- fread("./kako 2nd/test.csv")

3 Data Structure and Description

3.1 Data Structure

dim(k_train)  # 21개 변수의 15035 관측치다.

## [1] 15035    21

dim(k_test)   # price를 제외한 20개 변수의 6468 관측치이며, k_train대비 비율은 5:2이다.

## [1] 6468   20

str(k_train)  # 숫자 & 문자 변수 혼합 타입으로 구성된 2차원 이상의 데이터이다.

## Classes 'data.table' and 'data.frame':   15035 obs. of  21 variables:
##  $ id           : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ date         : chr  "20141013T000000" "20150225T000000" "20150218T000000" "20140627T000000" ...
##  $ price        : num  221900 180000 510000 257500 291850 ...
##  $ bedrooms     : int  3 2 3 3 3 3 2 3 3 5 ...
##  $ bathrooms    : num  1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
##  $ sqft_living  : int  1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
##  $ sqft_lot     : int  5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
##  $ floors       : num  1 1 1 2 1 1 1 1.5 1 1.5 ...
##  $ waterfront   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ view         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ condition    : int  3 3 3 3 3 3 4 4 4 3 ...
##  $ grade        : int  7 6 8 7 7 8 7 7 7 7 ...
##  $ sqft_above   : int  1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
##  $ sqft_basement: int  0 0 0 0 0 1700 300 0 0 0 ...
##  $ yr_built     : int  1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
##  $ yr_renovated : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ zipcode      : int  98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
##  $ lat          : num  47.5 47.7 47.6 47.3 47.4 ...
##  $ long         : num  -122 -122 -122 -122 -122 ...
##  $ sqft_living15: int  1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
##  $ sqft_lot15   : int  5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
##  - attr(*, ".internal.selfref")=<externalptr>

str(k_test)   # 숫자 & 문자 변수 혼합 타입으로 구성된 2차원 이상의 데이터이다.

## Classes 'data.table' and 'data.frame':   6468 obs. of  20 variables:
##  $ id           : int  15035 15036 15037 15038 15039 15040 15041 15042 15043 15044 ...
##  $ date         : chr  "20141209T000000" "20141209T000000" "20140512T000000" "20150415T000000" ...
##  $ bedrooms     : int  3 4 4 3 3 5 3 4 2 4 ...
##  $ bathrooms    : num  2.25 3 4.5 1 2.5 2.5 1.75 2.5 1.5 1 ...
##  $ sqft_living  : int  2570 1960 5420 1780 1890 2270 1520 2570 1190 1660 ...
##  $ sqft_lot     : int  7242 5000 101930 7470 6560 6300 6380 7173 1265 34848 ...
##  $ floors       : num  2 1 1 1 2 2 1 2 3 1 ...
##  $ waterfront   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ view         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ condition    : int  3 5 3 3 3 3 3 3 3 1 ...
##  $ grade        : int  7 7 11 7 7 8 7 8 7 5 ...
##  $ sqft_above   : int  2170 1050 3890 1050 1890 2270 790 2570 1190 930 ...
##  $ sqft_basement: int  400 910 1530 730 0 0 730 0 0 730 ...
##  $ yr_built     : int  1951 1965 2001 1960 2003 1995 1948 2005 2005 1933 ...
##  $ yr_renovated : int  1991 0 0 0 0 0 0 0 0 0 ...
##  $ zipcode      : int  98125 98136 98053 98146 98038 98092 98115 98052 98133 98052 ...
##  $ lat          : num  47.7 47.5 47.7 47.5 47.4 ...
##  $ long         : num  -122 -122 -122 -122 -122 ...
##  $ sqft_living15: int  1690 1360 4760 1780 2390 2240 1520 2630 1390 2160 ...
##  $ sqft_lot15   : int  7639 5000 101930 8113 7570 7005 6235 6026 1756 11467 ...
##  - attr(*, ".internal.selfref")=<externalptr>

3.2 Combined the datasets

k_test.labels <- k_test$id # modeling 대비 id 벡터에 저장
k_all <- bind_rows(within(k_train, rm('id')), within(k_test, rm('id')))
# rbind는 열 개수가 다르면 결합 불가. bind_rows는 없던 열 결측치로 대체하여 결합.
dim(k_all)

## [1] 21503    20

str(k_all)

## Classes 'data.table' and 'data.frame':   21503 obs. of  20 variables:
##  $ date         : chr  "20141013T000000" "20150225T000000" "20150218T000000" "20140627T000000" ...
##  $ price        : num  221900 180000 510000 257500 291850 ...
##  $ bedrooms     : int  3 2 3 3 3 3 2 3 3 5 ...
##  $ bathrooms    : num  1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
##  $ sqft_living  : int  1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
##  $ sqft_lot     : int  5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
##  $ floors       : num  1 1 1 2 1 1 1 1.5 1 1.5 ...
##  $ waterfront   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ view         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ condition    : int  3 3 3 3 3 3 4 4 4 3 ...
##  $ grade        : int  7 6 8 7 7 8 7 7 7 7 ...
##  $ sqft_above   : int  1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
##  $ sqft_basement: int  0 0 0 0 0 1700 300 0 0 0 ...
##  $ yr_built     : int  1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
##  $ yr_renovated : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ zipcode      : int  98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
##  $ lat          : num  47.5 47.7 47.6 47.3 47.4 ...
##  $ long         : num  -122 -122 -122 -122 -122 ...
##  $ sqft_living15: int  1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
##  $ sqft_lot15   : int  5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...

3.3 Data Description

ID : 집을 구분하는 번호
date : 집을 구매한 날짜
price : 집의 가격(Target variable)
bedrooms : 침실의 수
bathrooms : 화장실의 수 (참고)
sqft_living : 주거 공간의 평방 피트(면적)
sqft_lot : 부지의 평방 피트(면적)
floors : 집의 층 수
waterfront : 집의 전방에 강이 흐르는지 유무 (a.k.a. 리버뷰)
view : 집이 얼마나 좋아 보이는지의 정도
condition : 집의 전반적인 상태
grade : King County grading 시스템 기준으로 매긴 집의 등급(구조 & 디자인) ( 하등급: 1~3등급, 중등급: 7 등급, 상등급: 11~13 등급 ) (참고)
sqft_above : 지하실을 제외한 평방 피트(면적)
sqft_basement : 지하실의 평방 피트(면적)
yr_built : 지어진 년도
yr_renovated : 집을 재건축한 년도
zipcode : 우편번호
lat : 위도
long : 경도
sqft_living15 : 2015년 기준 주거 공간의 평방 피트(면적, 집을 재건축했다면, 변화가 있을 수 있음)
sqft_lot15 : 2015년 기준 부지의 평방 피트(면적, 집을 재건축했다면, 변화가 있을 수 있음)

4 EDA(Exploratory Data Analysis)

4.1 Missing Values

sum(is.na(k_all))/(ncol(k_all)*nrow(k_all))  # train, test 결합하며 생긴 price의 결측치 같다.

## [1] 0.01503976

colSums(is.na(k_all))  #row 결합으로 생긴 price의 결측치만 보인다.

##          date         price      bedrooms     bathrooms   sqft_living 
##             0          6468             0             0             0 
##      sqft_lot        floors    waterfront          view     condition 
##             0             0             0             0             0 
##         grade    sqft_above sqft_basement      yr_built  yr_renovated 
##             0             0             0             0             0 
##       zipcode           lat          long sqft_living15    sqft_lot15 
##             0             0             0             0             0

# study 개념으로 시각화를 첨부한다.
# 각 feature 결측치 비율 계산
missing_values <- k_all %>% dplyr::summarise_all(funs(sum(is.na(.))/n()))

## Warning: funs() is soft deprecated as of dplyr 0.8.0
## please use list() instead
## 
## # Before:
## funs(name = f(.)
## 
## # After: 
## list(name = ~f(.))
## This warning is displayed once per session.

# data frame 생성
missing_values <- tidyr::gather(missing_values, key = 'feature', value = 'missing_pct')
# 그래프 생성
missing_values %>% 
  ggplot(aes(x= reorder(feature, missing_pct), y = missing_pct)) + # missing_pct 내림차순 정렬
  geom_bar(stat = 'identity', fill = 'red') + # 막대 그래프 생성
  ggtitle('Rechecking missing values in each features') + # 제목 
  theme(plot.title = element_text(face = 'italic',        # 글씨체
                                  hjust = 0.5,            # 가로비율(Horizon)
                                  size = 15,              # 폰트 크기
                                  color = 'black')) +     # 폰트 컬러
labs(x = 'Feature names', y = 'Rate') +                   # x, y 축 명명
  coord_flip()                                            # x, y 축 반전

# 시각화 확인 결과 데이터셋 합산하며 생긴 price 제외 NA는 없다.

4.2 Data detail overview

head(k_all,10)  # Chapter 3.3 설명대로 값들은 예상과 맞지만, date는 수정할 필요가 있어 보인다.

##                date  price bedrooms bathrooms sqft_living sqft_lot floors
##  1: 20141013T000000 221900        3      1.00        1180     5650    1.0
##  2: 20150225T000000 180000        2      1.00         770    10000    1.0
##  3: 20150218T000000 510000        3      2.00        1680     8080    1.0
##  4: 20140627T000000 257500        3      2.25        1715     6819    2.0
##  5: 20150115T000000 291850        3      1.50        1060     9711    1.0
##  6: 20150403T000000 662500        3      2.50        3560     9796    1.0
##  7: 20140527T000000 468000        2      1.00        1160     6000    1.0
##  8: 20140528T000000 310000        3      1.00        1430    19901    1.5
##  9: 20141007T000000 400000        3      1.75        1370     9680    1.0
## 10: 20150312T000000 530000        5      2.00        1810     4850    1.5
##     waterfront view condition grade sqft_above sqft_basement yr_built
##  1:          0    0         3     7       1180             0     1955
##  2:          0    0         3     6        770             0     1933
##  3:          0    0         3     8       1680             0     1987
##  4:          0    0         3     7       1715             0     1995
##  5:          0    0         3     7       1060             0     1963
##  6:          0    0         3     8       1860          1700     1965
##  7:          0    0         4     7        860           300     1942
##  8:          0    0         4     7       1430             0     1927
##  9:          0    0         4     7       1370             0     1977
## 10:          0    0         3     7       1810             0     1900
##     yr_renovated zipcode     lat     long sqft_living15 sqft_lot15
##  1:            0   98178 47.5112 -122.257          1340       5650
##  2:            0   98028 47.7379 -122.233          2720       8062
##  3:            0   98074 47.6168 -122.045          1800       7503
##  4:            0   98003 47.3097 -122.327          2238       6819
##  5:            0   98198 47.4095 -122.315          1650       9711
##  6:            0   98007 47.6007 -122.145          2210       8925
##  7:            0   98115 47.6900 -122.292          1330       6000
##  8:            0   98028 47.7558 -122.229          1780      12697
##  9:            0   98074 47.6127 -122.045          1370      10208
## 10:            0   98107 47.6700 -122.394          1360       4850

summary(k_all)  # 수치형이지만 실제론 범주형인 값들이 보인다.

##      date               price            bedrooms        bathrooms    
##  Length:21503       Min.   :  78000   Min.   : 0.000   Min.   :0.000  
##  Class :character   1st Qu.: 322000   1st Qu.: 3.000   1st Qu.:1.750  
##  Mode  :character   Median : 450000   Median : 3.000   Median :2.250  
##                     Mean   : 540683   Mean   : 3.372   Mean   :2.116  
##                     3rd Qu.: 645000   3rd Qu.: 4.000   3rd Qu.:2.500  
##                     Max.   :7700000   Max.   :33.000   Max.   :8.000  
##                     NA's   :6468                                      
##   sqft_living       sqft_lot           floors        waterfront     
##  Min.   :  290   Min.   :    520   Min.   :1.000   Min.   :0.00000  
##  1st Qu.: 1430   1st Qu.:   5040   1st Qu.:1.000   1st Qu.:0.00000  
##  Median : 1914   Median :   7616   Median :1.500   Median :0.00000  
##  Mean   : 2081   Mean   :  15117   Mean   :1.495   Mean   :0.00758  
##  3rd Qu.: 2550   3rd Qu.:  10686   3rd Qu.:2.000   3rd Qu.:0.00000  
##  Max.   :13540   Max.   :1651359   Max.   :3.500   Max.   :1.00000  
##                                                                     
##       view          condition        grade          sqft_above  
##  Min.   :0.0000   Min.   :1.00   Min.   : 1.000   Min.   : 290  
##  1st Qu.:0.0000   1st Qu.:3.00   1st Qu.: 7.000   1st Qu.:1200  
##  Median :0.0000   Median :3.00   Median : 7.000   Median :1560  
##  Mean   :0.2346   Mean   :3.41   Mean   : 7.659   Mean   :1790  
##  3rd Qu.:0.0000   3rd Qu.:4.00   3rd Qu.: 8.000   3rd Qu.:2210  
##  Max.   :4.0000   Max.   :5.00   Max.   :13.000   Max.   :9410  
##                                                                 
##  sqft_basement       yr_built     yr_renovated        zipcode     
##  Min.   :   0.0   Min.   :1900   Min.   :   0.00   Min.   :98001  
##  1st Qu.:   0.0   1st Qu.:1951   1st Qu.:   0.00   1st Qu.:98033  
##  Median :   0.0   Median :1975   Median :   0.00   Median :98065  
##  Mean   : 291.7   Mean   :1971   Mean   :  84.74   Mean   :98078  
##  3rd Qu.: 560.0   3rd Qu.:1997   3rd Qu.:   0.00   3rd Qu.:98117  
##  Max.   :4820.0   Max.   :2015   Max.   :2015.00   Max.   :98199  
##                                                                   
##       lat             long        sqft_living15    sqft_lot15    
##  Min.   :47.16   Min.   :-122.5   Min.   : 399   Min.   :   651  
##  1st Qu.:47.47   1st Qu.:-122.3   1st Qu.:1490   1st Qu.:  5100  
##  Median :47.57   Median :-122.2   Median :1840   Median :  7620  
##  Mean   :47.56   Mean   :-122.2   Mean   :1987   Mean   : 12774  
##  3rd Qu.:47.68   3rd Qu.:-122.1   3rd Qu.:2370   3rd Qu.: 10085  
##  Max.   :47.78   Max.   :-121.3   Max.   :6210   Max.   :871200  
##

4.3 Make a fuction for plotting actually categoric data

plot.categoric <- function(cols, df){
  for (col in cols) {
    order.cols <- names(sort(table(k_all[,col]), decreasing = TRUE))
  
    num.plot <- qplot(df[,col]) +
      geom_bar(fill = 'cornflowerblue') +
      geom_text(aes(label = ..count..), stat='count', vjust=-0.5) +
      theme_minimal() +
      scale_y_continuous(limits = c(0,max(table(df[,col]))*1.1)) +
      scale_x_discrete(limits = order.cols) +
      xlab(col) +
      theme(axis.text.x = element_text(angle = 30, size=12))
  
    print(num.plot)
  }
}

4.4 Modify a date format

k_all[, date:=substr(date, 1, 8)]   # date에서 불필요 부분 제거하여 연간 구매로 변수 생성
k_all %>% select(date) %>% head(10)

##         date
##  1: 20141013
##  2: 20150225
##  3: 20150218
##  4: 20140627
##  5: 20150115
##  6: 20150403
##  7: 20140527
##  8: 20140528
##  9: 20141007
## 10: 20150312

4.5 detail price & visualization

summary(k_all$price)  # price 분포 확인

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   78000  322000  450000  540683  645000 7700000    6468

price.g <- ggplot(data=k_all[!is.na(k_all$price)], aes(x=price)) + 
  geom_histogram(fill = 'red', binwidth = 10000) +
  scale_x_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
ggplotly(price.g)     # 인터랙티브 그래프로 금액대별 거래량 분포 확인

금액대는 35만에서 거래가 가장 많았으며, 평균은 54만이고, 75% 거래량 까지가 64만으로 주로 100만 안에서 거래량이 많았다. 200만이 넘어서는 10건 이하로 거래가 되었고, 4백만 이후부터는 1건씩 거래가 이루어졌다.

4.6 Correlation with price

상관 관계 히트맵

str(k_all)  # pearson(수치형) & spearman(수치 & 범주형 혼합) 계수 생성위해 확인

## Classes 'data.table' and 'data.frame':   21503 obs. of  20 variables:
##  $ date         : chr  "20141013" "20150225" "20150218" "20140627" ...
##  $ price        : num  221900 180000 510000 257500 291850 ...
##  $ bedrooms     : int  3 2 3 3 3 3 2 3 3 5 ...
##  $ bathrooms    : num  1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
##  $ sqft_living  : int  1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
##  $ sqft_lot     : int  5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
##  $ floors       : num  1 1 1 2 1 1 1 1.5 1 1.5 ...
##  $ waterfront   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ view         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ condition    : int  3 3 3 3 3 3 4 4 4 3 ...
##  $ grade        : int  7 6 8 7 7 8 7 7 7 7 ...
##  $ sqft_above   : int  1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
##  $ sqft_basement: int  0 0 0 0 0 1700 300 0 0 0 ...
##  $ yr_built     : int  1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
##  $ yr_renovated : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ zipcode      : int  98178 98028 98074 98003 98198 98007 98115 98028 98074 98107 ...
##  $ lat          : num  47.5 47.7 47.6 47.3 47.4 ...
##  $ long         : num  -122 -122 -122 -122 -122 ...
##  $ sqft_living15: int  1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
##  $ sqft_lot15   : int  5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...

k_numericVars <- which(sapply(k_all, is.numeric))  # index vector numeric variables
k_numericVarnames <- names(k_numericVars) # 이름 명명
cat('There are', length(k_numericVars), 'numeric variables')

## There are 19 numeric variables

k_all.numVar <- k_all[, ..k_numericVars]
k_cor.numVar <- cor(k_all.numVar, use = 'pairwise.complete.obs', method="spearman") # 결측값 제외 상관행렬 생성
# price 기준 내림차순 정렬
k_cor.sorted <- as.matrix(sort(k_cor.numVar[, 'price'], decreasing = TRUE)) 
k_corHigh <- names(which(apply(k_cor.sorted, 1, function(x) abs(x) > 0)))
k_cor.numVar <- k_cor.numVar[k_corHigh, k_corHigh] 
# 상관 행렬 히트맵
corrplot.mixed(k_cor.numVar, 
               tl.col = 'black',  # 변수명 색깔
               tl.pos = 'lt',     # 변수명 왼쪽 표시
               tl.cex = 0.7,      # 변수명 text 크기
               cl.cex = 0.7,      # y축 상관계수 text 크기
               number.cex = .5    # matrix안 상관계수 text 크기
               )

상관 행렬 확인 결과 주거 공간의 크기, 등급, 지상 평방피트 등 상위에 공간의 면적과 관련된 항목들이 있음을 알 수 있다. 그리고 침실의 개수보단 욕실이 가격과 상관 관계가 더 높고, 한국이라면 영향이 컸을 리버뷰(waterfront)는 상관 관계가 그리 높지 않았다. 의문은 위도와는 상관 관계가 0.45이지만, 경도와는 0.07로 이건 지역의 특성인것 같은데 확인해 봐야 할 것 같다.

4.7 Label Encoding / Factorizing variables

4.7.1 grade variables

# grade boxplot (하등급: 1~3등급, 중등급: 7 등급, 상등급: 11~13 등급)
k_g1 <- ggplot(data=k_all[!is.na(k_all$price),], aes(x= factor(grade), y = price)) + #grade 범주형 변수로 변환
  geom_boxplot(col = 'black') + labs(x = 'grade') + 
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$grade[!is.na(k_all$price)]== 11 & k_all$price[!is.na(k_all$price)] > 7000000, rownames(k_all),''), vjust = 1.5))

k_g2 <- ggplot(data = k_all, aes(x = as.factor(grade))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size =3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_g1, k_g2)

11등급인데 가격이 너무 높은 이상치가 있다. 확인해 봐야 할 것 같다.

4.7.2 sqft_living variables

# sqft_living 분포 확인
ggplot(data=k_all[!is.na(k_all$price)], aes(x = sqft_living, y=price)) +
  geom_point(col = 'blue') + 
  geom_smooth(method = 'lm', se= FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$sqft_living[!is.na(k_all$price)] > 10000, rownames(k_all), ''), vjust=1.5))

price 관측치 ’8913’은 면적 대비 가격이 낮아 보인다. 가장 상위 가격인 ’5109’와 비교해보겠다.

k_all[c(5109, 8913), c('price','sqft_living', 'grade','bathrooms', 'bedrooms')]

##      price sqft_living grade bathrooms bedrooms
## 1: 7700000       12050    13         8        6
## 2: 2280000       13540    12         8        7

면적, 등급, 욕실 상태와 침실 수도 큰 차이는 안나지만 가격이 3배 차이 나는건 확인해 봐야겠다.

4.7.3 sqft_living15 variables

# sqft_living15 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_living15, y = price)) + 
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) + 
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(sqft_living15[!is.na(k_all$price)] > 6000, rownames(k_all), ''), vjust = 1.5))

living15에서도 면적 대비 가격이 낮은 값들이 보인다. living에선 이상치가 2건 정도였는데, 여기선 꽤 많은 값들이 있다. 여기선 변별하기가 힘들것 같아 추후 다른 값에서 비교해보겠다.

4.7.4 sqft_above variables

# sqft_above 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_above, y = price)) +
  geom_point(col = 'blue') + 
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) + 
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$sqft_above[!is.na(k_all$price)] > 7500, rownames(k_all), ''), vjust= 1.5))

4.7.5 bathrooms variables

# bathrooms boxplot(0.5:세면대 화장실, 0.75: 0.5+샤워실, 1: 0.75+욕조)
k_b1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(bathrooms), y = price)) + #bathrooms 범주형 변수로 변환
  geom_boxplot( col = 'black') +labs(x = 'bathrooms') +
  scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(bathrooms[!is.na(k_all$price)]<=5.25 & price>5000000, rownames(k_all), ''), vjust = 1.5)) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

k_b2 <- ggplot(data = k_all, aes(x = as.factor(bathrooms))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_b1, k_b2)

4.25부터 5.5까지 이상치가 존재하고, 5.5와 5.75는 최대치가 높아보인다. 확인해 봐야 할 것 같다.

4.7.6 lat variables

# lat 
ggplot(data = k_all[!is.na(k_all$price),], aes(x = lat, y = price)) + 
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), label = comma) +
  geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))

위도가 상승할수록 가격도 오르는 걸 확인할 수 있다. 추후에 연관성이 있는 항목들을 재검토 하겠다.

4.7.7 bedrooms variables

# bedrooms boxplot
k_d1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(bedrooms), y = price)) + # bedrooms 범주형 변수로 변환
  geom_boxplot(col = 'black') + labs(x = 'bedrooms') + 
  scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))

k_d2 <- ggplot(data = k_all, aes(x = as.factor(bedrooms))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_d1, k_d2)

3,4,5,6에서 이상치가 많이 보이고, 5,6은 특출난 수치들이 있다. 확인해 봐야 할 것 같다.

4.7.8 floors variables

k_f1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(floors), y = price)) +
  geom_boxplot(col = 'black') + labs(x = 'floors') +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$floors[!is.na(k_all$price)]==2.5 & price > 7000000, rownames(k_all), ''), vjust = 1.5))

k_f2 <- ggplot(data= k_all, aes(x = as.factor(floors))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_f1, k_f2)

’5109’는 floors 변수에서도 이상치로 나타난다. 면적대비 가격이 낮으면서 2.5층의 값이다.

4.7.9 view variables

# view boxplot
k_v1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = factor(view), y = price)) + # view 범주형 변수로 변환
  geom_boxplot(col = 'black') + labs(x = 'view') +
  scale_y_continuous(breaks = seq(0,8000000, by = 1000000), label = comma) +
  geom_text(aes(label = ifelse(price > 5500000, rownames(k_all), ''), vjust = 1.5))

k_v2 <- ggplot(data = k_all, aes(x = as.factor(view))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_v1, k_v2)

0,2,3,4가 view 대비 특출난 이상치들이 있다. 확인해 봐야 할 것 같다.

4.7.10 sqft_basement variables

# sqft_basement 분포 확인
ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_basement, y = price)) + 
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0,8000000, by = 1000000), label = comma) +
  geom_text(aes(label = ifelse(price > 6000000, rownames(k_all), ''), vjust = 1.5))

지하실 면적과 가격간의 상관은 있어보이지만, 0에 많은 수치가 몰려있다. 지하실이 없을 경우를 0으로 표현한 것 같은데, 확인해 봐야 할 것 같다.

4.7.11 waterfront variables

k_w1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x= factor(waterfront), y = price)) +
  geom_boxplot(col = 'black') + labs(x = 'waterfront') +
  scale_y_continuous(breaks = seq(0,8000000, by = 1000000), labels = comma)

k_w2 <- ggplot(data = k_all, aes(x = as.factor(waterfront))) +
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
grid.arrange(k_w1, k_w2)

강이 보이는 곳이 평균적으로 가격이 높지만, 강이 안 보이더라도 비싼 곳들이 있다.

4.7.12 yr_renovated variables

ggplot(data=k_all[!is.na(k_all$price),], aes(x = factor(yr_renovated), y = price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)

k_all %>% select(yr_renovated) %>% table()

## .
##     0  1934  1940  1944  1945  1946  1948  1950  1951  1953  1954  1955 
## 20590     1     2     1     3     2     1     2     1     3     1     3 
##  1956  1957  1958  1959  1960  1962  1963  1964  1965  1967  1968  1969 
##     3     3     5     1     4     2     4     5     5     2     8     4 
##  1970  1971  1972  1973  1974  1975  1976  1977  1978  1979  1980  1981 
##     9     2     4     5     3     6     3     8     6    10    10     5 
##  1982  1983  1984  1985  1986  1987  1988  1989  1990  1991  1992  1993 
##    11    18    18    17    17    18    15    22    25    20    17    19 
##  1994  1995  1996  1997  1998  1999  2000  2001  2002  2003  2004  2005 
##    19    16    15    15    19    17    35    19    22    36    26    35 
##  2006  2007  2008  2009  2010  2011  2012  2013  2014  2015 
##    24    35    18    22    18    13    11    37    91    16

값이 0인 값들이 많다. 재건축 유무를 구분하여 변수를 새로 만들어서 확인해봐야 할 것 같다. 년도는 테이블로 확인하였다.

4.7.13 yr_built variables

ggplot(data=k_all[!is.na(k_all$price),], aes(x = factor(yr_built), y =price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se= FALSE, color ='black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  theme(axis.text.x = element_text(angle = 45, hjust =1))

k_all %>% select(yr_built) %>% table()

## .
## 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 
##   86   29   27   45   44   74   91   65   86   94  132   72   78   58   53 
## 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 
##   64   79   56  120   88   98   74   94   83  139  164  179  115  126  114 
## 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 
##   90   61   37   29   21   24   39   68   52  104  154  161  222  168  139 
## 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 
##   94  125  262  235  191  247  228  220  220  302  267  194  198  223  333 
## 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 
##  247  224  310  252  172  187  248  348  380  278  130  104  148  147  162 
## 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 
##  189  252  416  384  342  237  199  103  212  227  228  215  292  267  290 
## 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 
##  318  224  198  200  249  168  194  174  239  264  218  305  222  422  431 
## 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 
##  450  454  416  366  228  143  130  169  200  558   38

집값과의 상관 관계는 크게 없어 보인다. 차트에선 년도가 잘 안보여 수치로 보았다. 1900년~ 2015년까지 분포되어 있다.

4.7.14 sqft_lot variables

ggplot(data=k_all[!is.na(k_all$price),], aes(x = sqft_lot, y = price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group=1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$sqft_lot[!is.na(k_all$price)] > 1500000, rownames(k_all), ''), vjust= 1.5))

summary(k_all$sqft_lot)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     520    5040    7616   15117   10686 1651359

상관 관계는 보이지만, 75%의 수가 0~1만 사이에 몰려있다. Min과 Max의 차가 굉장히 크다.

4.7.15 sqft_lot15

ggplot(data=k_all[!is.na(k_all$price),], aes(x = sqft_lot15, y = price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)

4.7.16 long variables

ggplot(data = k_all[!is.na(k_all$price),], aes(x = long, y = price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 10000000), labels = comma)

lat과는 달리 long은 큰 상관 관계가 보이지 않는다.

4.7.17 condition variables

k_c1 <- ggplot(data= k_all[!is.na(k_all$price),], aes(x = factor(condition), y= price)) +
  geom_boxplot(col= 'black') + labs(x = 'condition') +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label = ifelse(k_all$condition[!is.na(k_all$price)] >= 3 & price > 6000000, rownames(k_all), ''), vjust = 0.5, hjust=1.5))

k_c2 <- ggplot(k_all, aes(x = as.factor(condition))) + 
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust =1))
grid.arrange(k_c1, k_c2)

4.7.18 zipcode variables

k_z1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(zipcode), y = price)) +
  geom_point(color = 'blue') +
  geom_smooth(methdo = 'lm', se= FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 10000000), labels = comma)

k_z2 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(zipcode), group= factor(zipcode), y = price)) +
  geom_boxplot(color = 'black') +
  theme_light()+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma)
grid.arrange(k_z1, k_z2)

zipcode는 추후 다시 살펴봐야겠다.

4.8 high correlations related variables visualization

4.8.1 sqft_living, and other surface related variables (in square feet)

섹션 4.6에서 살펴본 바와 같이 상관 계수 상위에 면적과 관련한 변수가 많이 분포되어 있다. 실제적으로 집을 구매시 집의 면적은 가격과 더불어 아주 중요하다. 여기서는 면적 관련한 변수들을 한눈에 확인하여 또 다른 인사이트를 얻을 수 있을지 알아보겠다. 욕실과 침실은 면적에는 포함되지 않지만, living_area와 상관 관계가 높기(0.75, 0.65)에 추가를 하였다.

k_s1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_living)) +
  geom_density() + labs(x= 'Square feet living area')
k_s2 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_living15)) +
  geom_density() + labs(x='Square feet living area(year:2015)')
k_s3 <- ggplot(data = k_all[!is.na(k_all$price)& k_all$sqft_lot<100000], aes(x = sqft_lot)) +
  geom_density() + labs(x = 'Square feet lot') # 시각화 위해 10만 이상의 값 제거
k_s4 <- ggplot(data = k_all[!is.na(k_all$price)& k_all$sqft_lot15<100000], aes(x = sqft_lot15)) +
  geom_density() + labs(x = 'Square feet lot(year:2015)') # 시각화 위해 10만 이상의 값 제거
k_s5 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_above)) +
  geom_density() + labs(x = 'Square feet above')
k_s6 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = sqft_basement)) +
  geom_density() + labs(x = 'Square feet basement')
k_s7 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(bedrooms))) +
  geom_histogram(stat = 'count') + labs(x = 'Bedrooms')
k_s8 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(bathrooms))) +
  geom_histogram(stat = 'count') +labs(x = 'Bathrooms') +
  theme(axis.text.x = element_text(angle =90, hjust = 1))

k_layout <- matrix(c(1,3,2,4,5,6,7,8),4,2, byrow = TRUE) # 4행 2열 ()안의 순으로 행부터 matrix 생성
multiplot(k_s1, k_s2, k_s3, k_s4, k_s5, k_s6, k_s7, k_s8, layout = k_layout)

면적은 전반적으로 왼쪽으로 많이 치우친 모양이지만, 앞에서도 확인했듯이 몇 몇 이상치가 수치를 끌어올리는 것으로 보인다. 이상치는 추후에 확인 후 제거하겠다.

4.8.2 grade, and other Quality variables

집의 등급과 전반적인 상태를 나타내는 변수가 3개 있어 같이 시각화 해보겠다.

k_q1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(grade))) +
  geom_histogram(stat = 'count') + labs(x = 'Grade')
k_q2 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(condition))) +
  geom_histogram(stat = 'count') + labs(x = 'Condition')
k_q3 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = as.factor(view))) +
  geom_histogram(stat = 'count') +labs(x = 'View')

k_layout <- matrix(c(1,2,3), 1,3, byrow = TRUE)
multiplot(k_q1, k_q2, k_q3, layout = k_layout)

‘grade’변수는 7,8에 다수가 몰려 있으며, ’condition’ 변수는 3에, ’View’는 0에 다수가 몰려 있다. ’View’가 0에 많은 변수가 몰려 있는게 기준이 어떻게 되는지 궁금하다.

4.8.3 Seperated date variables

연별, 월별 구매량을 date변수를 분할하여 알아보겠다.

k_all[, Yrbuy:=substr(date, 1,4)]    # 연간 구매 확인 위해 변수 생성
k_all[, Mobuy:=substr(date, 5, 6)]   # 월간 구매 확인 위해 변수 생성 
k_all[, Yrmbuy:=substr(date, 1, 6)]   # 추후 사용

k_y1 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = Yrbuy, y = price)) +
  geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
  geom_label(stat = 'count', aes(label= ..count.., y = ..count..)) +
  coord_cartesian(ylim = c(0, 600000)) + 
  geom_hline(yintercept = 450000, linetype ='dashed', color = 'red') + #price 중위
  scale_y_continuous(breaks = seq(0, 800000, by = 100000), labels = comma) +
  theme_light()+ theme(axis.text.x = element_text(vjust = 0.5)) + labs(x = 'Year median') 

k_y2 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = Mobuy, y = price)) +
  geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size=2) +
  coord_cartesian(ylim = c(0, 600000)) + 
  geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red') +
  scale_y_continuous(breaks = seq(0, 800000, by = 100000), labels = comma) +
  theme_light() + theme(axis.text.x = element_text(vjust=0.5)) + labs(x = 'Month median')

k_y3 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = Yrbuy, y = price)) +
  geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..)) +
  coord_cartesian(ylim = c(0, 600000)) + 
  geom_hline(yintercept = 540683, linetype='dashed', color = 'red') + #price 평균값
  scale_y_continuous(breaks = seq(0, 800000, by = 100000), labels = comma) +
  theme_light() + theme(axis.text.x = element_text(vjust = 0.5)) + labs(x = 'Year mean')

k_y4 <- ggplot(data = k_all[!is.na(k_all$price),], aes(x = Mobuy, y = price))+
  geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size=2) +
  coord_cartesian(ylim = c(0, 600000)) + 
  geom_hline(yintercept = 540683, linetype = 'dashed', color = 'red') + #price 평균값
  scale_y_continuous(breaks = seq(0, 800000, by = 100000), labels = comma) +
  theme_light() + theme(axis.text.x = element_text(vjust = 0.5)) + labs(x = 'Month mean')

k_layout <- matrix(c(1,2,3,4),2,2, byrow = TRUE)
multiplot(k_y1, k_y2, k_y3, k_y4, layout = k_layout)

2015년 대비 2014년의 구매 빈도가 2배 이상 높고, 월별 구매는 1,2월에는 다른 월 대비 구매 빈도가 낮다. 구매가의 중위값으로 보면 유의미한 결과는 따로 없어 보인다.

5 Feature Engineering

건축년도로 구분한 집의 년수와, 리모델링 여부, 신축 여부를 구분 지어 변수를 만들겠다.

5.1 Adding ‘House Age’, Remodeled(Yes/No)’, IsNew

k_all$Remod <- ifelse(k_all$yr_built > k_all$yr_renovated, 0, 1) # 0 = '리모델링 X', 1 = '리모델링'
temp <- ifelse(k_all$yr_renovated==0, k_all$yr_built, k_all$yr_renovated) #재건축이 아니면 디폴트로 건축년도 설정
k_all$Age <- as.numeric(k_all$Yrbuy)-temp

ggplot(k_all[!is.na(k_all$price),], aes(x = Age, y=price)) +
  geom_point(col = 'blue') +
  geom_smooth(method = 'lm', se = FALSE, color = 'black', aes(group = 1)) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  geom_text(aes(label=ifelse(price > 7000000, rownames(k_all), ''), vjust = 0.5))

재건축을 하거나, 건축된지 30년 미만의 집이 고가에 거래된 경우가 많다.

ggplot(k_all[!is.na(k_all$price),], aes(x = as.factor(Remod), y = price)) +
  geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 6) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  theme_grey(base_size = 18)+
  geom_hline(yintercept = 450000, linetype = 'dashed')

재건축된 집이 더 비싸다.

k_all$IsNew <- ifelse(k_all$yr_renovated>=2014, 1, 0) # 1은 신축, 0은 기
table(k_all$IsNew)

## 
##     0     1 
## 21396   107

107채의 14년 이후 신축집은 train과 test셋에 분배되어 있으며, 기존 집들보다 더 비싼 경향을 보인다.

ggplot(k_all[!is.na(k_all$price),], aes(x = as.factor(IsNew), y = price)) +
  geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 6) +
  scale_y_continuous(breaks = seq(0, 8000000, by = 1000000), labels = comma) +
  theme_light() +
  geom_hline(yintercept = 450000, linetype='dashed') # 점선은 판매가의 중위값

5.2 Adding ‘city’ variables

zipcode 라이브러리를 써서 zipcode별 city를 변수로 추가하겠다.

zc <- data.frame(k_all$zipcode) # zipcode 변수 추출
data(zipcode) # zipcode 라이브러리에서 변수 생성
colnames(zc)[1]='zip' # join 사전작업 컬럼명 동일하게 변경
zipcode$zip=as.integer(zipcode$zip) # join 사전작업 character > int로 변환
zc = left_join(zc,zipcode,by='zip') # left_join으로 'zc' 기준 결합
zc = zc %>% select(-'state') # 모든 state가 'WA'로 동일하므로 state 컬럼 삭제
k_all <- mutate(k_all, city= zc$city) # city 변수 추가

city별 가격 분포 확인

ggplot(data = k_all[!is.na(k_all$price),], aes(x = city, group= city, y = price)) +
  geom_boxplot(color = 'black') +
  theme_light()+
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5)) +
  scale_y_continuous(labels = comma)

ggplot(k_all[!is.na(k_all$price),], aes(x = city)) + 
  geom_histogram(stat = 'count') +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 3) +
  theme(axis.text.x = element_text(angle = 45, hjust =1))

## Warning: Ignoring unknown parameters: binwidth, bins, pad

’Seattle’과 ’Bellevue’는 분포가 많고, 이상치들로 가격대가 높은 집들이 좀 있어 보이고, ’Medina’는 분포 대비 부촌으로 보인다.(36채로 가장 적은 분포)

k_zc1 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = median), y = price))+
  geom_bar(stat = 'summary', fun.y = 'median', fill = 'blue') +
  labs(x = 'city', y = 'Median_price') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = comma) +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
  geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')
  

k_zc2 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = mean), y = price))+
  geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
  labs(x = 'city', y = 'Mean_price') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = comma) +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
  geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')

grid.arrange(k_zc1, k_zc2)

평균값과 중위값은 ’Medina’가 가장 높고, 그 다음이 지도상으로 그 바로 아래 위치한 ’Mercer Island’이다. 이 변수에서 위도와 가격과의 상관 관계가 높게 나왔을 것으로 추측된다.(경도는 비슷, 위도가 약간 아래) 분포가 많았던 ’Seattle’은 분포와 가격과의 상관은 크게 없어 보인다.

k_zc3 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = max), y = price))+
  geom_bar(stat = 'summary', fun.y = 'max', fill = 'blue') +
  labs(x = 'city', y = 'Max_price') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = comma) +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
  geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')


k_zc4 <- ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, price, FUN = min), y = price))+
  geom_bar(stat = 'summary', fun.y = 'min', fill = 'blue') +
  labs(x = 'city', y = 'Min_price') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(labels = comma) +
  geom_label(stat = 'count', aes(label = ..count.., y = ..count..), size = 2.5) +
  geom_hline(yintercept = 450000, linetype = 'dashed', color = 'red')

grid.arrange(k_zc3, k_zc4)

최대값을 보면 처음에 봤던 박스 플롯의 분포를 확인할 수 있고, 최소값을 보면 ’Medina’와 ’Mercer Island’는 타 지역대비 높은 값을 보이는 걸 알 수 있다. 상기의 도시별 차트들을 보면 시애틀과 벨뷰에 많은 인구가 살고, 메디나와 머서 아일랜드에는 높은 가격대의 집들이 있어 이들 일대가 시가지이고, 이 곳에서 멀어질수록 가격도 낮아지고, 분포도 적은 것을 알 수 있다.

5.3 Adding ‘Expensive city’ variables

’Medina’와 ’Mercer Island’는 가격과 상관도가 높은 변수이다. 그래서 이 둘을 묶은 변수를 하나 추가하겠다.

k_all$mecity <- ifelse(k_all$city=='Medina' | k_all$city=='Mercer Island', 1, 0) # 1은 부촌, 0은 그 외

5.4 Adding ‘sqft_lot per price’ & ‘sqft_living per price’ variables

부지 기준 평당 단가와 건물 기준 평당 단가 변수 생성

livingp <- k_all[!is.na(k_all$price),] %>% group_by(zipcode) %>% summarise(mean_living_per_price=mean(price/sqft_living), mean_lot_per_price=mean(price/sqft_lot))
#k_all <- left_join(k_all, livingp, by = 'zipcode') %>% as.data.table
#k_all$living_per_price <- k_all$price/k_all$sqft_living
#k_all$lot_per_price <- k_all$price/k_all$sqft_lot
str(livingp)

## 'data.frame':    1 obs. of  2 variables:
##  $ mean_living_per_price: num 264
##  $ mean_lot_per_price   : num 88.7

도시별 가격을 비교했을 때 봤던 것과 같이 건물당 단가는 ‘Medina’, ‘Mercer Island’, ‘Bellevue’ 순으로 동일하다. 하지만 부지당 단가로 비교하면 건물당 단가일때는 4,9번째였던 ‘Seattle’과 ’Issaquah’가 1,3번째로 높게 나온다. 이들 두 곳은 건물 대비해서 부지가 넓어 보인다. ’Medina’와 ’Mercer Island’,’Belleuvue’는 부지보단 건물로 인해 가격이 높게 나오는 것 같다.

5.5 Adding ‘sqft_living / sqft_lot’ variables

상기 부지당 평단가와 건물당 평단가를 비교한 상기의 변수에서 좀 더 확인하기 위해 추가했다.

k_all$living_divide_lot <- k_all$sqft_living/k_all$sqft_lot

ggplot(k_all[!is.na(k_all$price),], aes(x = reorder(city, living_divide_lot, FUN = mean), y = living_divide_lot))+
  geom_bar(stat = 'summary', fun.y = 'mean', fill = 'blue') +
  labs(x = 'city', y = 'living_divide_lot') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  scale_y_continuous(breaks = seq(0, 5, by = 1),labels = comma)

5.6 Adding ‘TotalRooms’ variables

‘bathrooms’ + ‘bedrooms’해서 ’TotalRooms’ 변수를 만들겠다.

k_all$TotalRooms <- k_all$bathrooms + k_all$bedrooms

부지당 평단가가 높았던’Issaquah’와 ’Seattle’이 주거 공간 대비 부지의 공간이 넓다. (수정중)

#living15 변수 의미 파악 위한 작업

#living15 <- k_all[!is.na(k_all$price),] %>% filter(city == 'Medina') %>% select(lat, long, sqft_living, sqft_living15, sqft_lot, sqft_lot15, living_divide_lot) %>% arrange(desc(lat))

#Medina <- k_all[!is.na(k_all$price),] %>% filter(city == 'Medina') %>%  arrange(desc(lat))

#k_all[!is.na(k_all$price),] %>% filter(city == 'Medina' , (lat >= 47.63 & lat< 47.64)) %>% select(lat, long, sqft_living, sqft_living15, sqft_lot, sqft_lot15) %>% arrange(desc(lat))

5.7 Again Correalation with price

FE 끝난 시점에서 상관 관계를 다시 확인해 보겠다.

k_all3 <- as.data.table(k_all) # 상관 행렬위해 임시 data.table 생성
k_again.numericVars <- which(sapply(k_all3, is.numeric))
k_again.numericVarnames <- names(k_again.numericVars)
cat('there are', length(k_again.numericVars), 'numeric variables')

## there are 25 numeric variables

k_again.all.numVar <- k_all3[, ..k_again.numericVars]
k_again.cor.numVar <- cor(k_again.all.numVar, use = 'pairwise.complete.obs', method = 'spearman')

k_again.cor.sorted <- as.matrix(sort(k_again.cor.numVar[, 'price'], decreasing = TRUE))
k_again.corHigh <- names(which(apply(k_again.cor.sorted, 1, function(x) abs(x) > 0)))
k_again.cor.numVar <- k_again.cor.numVar[k_again.corHigh, k_again.corHigh]
corrplot.mixed(k_again.cor.numVar,
               tl.col = 'black', 
               tl.pos = 'lt',
               tl.cex = 0.7,
               cl.cex = 0.7,
               number.cex = .5)

6 Preparing data for modeling

참조 & 필사한 링크를 첨부한다. ’erikbruin’의 링크를 참조하다 에러가 나는 부분이 많아, 아래 ’psystat’님의 커널을 필사했다. 들어가는 변수가 달라 점수는 차이가 많이 난다. 컴퍼티션 기일 전날까지 변수 와 모델링은 수정할 예정이다.

https://www.kaggle.com/erikbruin/house-prices-lasso-xgboost-and-a-detailed-eda

https://www.kaggle.com/psystat/eda-and-lasso-rf-svm-xgb-grid-search/code

6.1 Removing Outliers

outlier <- k_all[c(2776,5109,8913,13810,7247,3135), c('price','city','sqft_living','sqft_lot','living_divide_lot')]
outlier

##      price     city sqft_living sqft_lot living_divide_lot
## 1: 7062500 Bellevue       10040    37325        0.26898861
## 2: 7700000  Seattle       12050    27600        0.43659420
## 3: 2280000  Redmond       13540   307752        0.04399646
## 4: 2700000 Issaquah        7850    89651        0.08756177
## 5: 2983000 Bellevue        7400    18898        0.39157583
## 6: 5570000   Medina        9200    35069        0.26233996

#2776, 5109는 대조군으로 두고 면적 대비 가격이 낮았던 '8913',' '13810', '7247'과 view가 0등급인데 가격이 높았던 '3135'를 이상치로 정하고 데이터를 확인해 보겠다.

대조군 대비 ‘8913’, ’13810’의 부지당 평단가가 너무 낮다. 대조군이 100단위인 반면, 이 두 이상치는 1,2자리이다. 이상치로 잡고 제거하겠다.

k_all <- k_all[-c(8913,13810),]

6.2 preprocessing

k_all[, Yrmbuy:=factor(Yrmbuy)]
k_all[, zipcode:=factor(zipcode)]
k_all[, city:=factor(city)]
k_all[, mecity:=factor(mecity)]
k_all[, waterfront:=factor(waterfront)]
k_all[, IsNew:=factor(IsNew)]
k_all[, Remod:=factor(Remod)]
k_all[, view:=factor(view)]
k_all[, grade:=factor(grade)]
k_all[, floors:=factor(floors)]
k_all[, TotalRooms:=factor(TotalRooms)]
k_all[, condition:=factor(condition)]

cat_vars <- c('waterfront', 'Yrmbuy','zipcode','mecity','city','IsNew','condition','Remod','view','grade','floors','TotalRooms') # 가져갈 변수
del_vars <- c('price','Yrbuy','Mobuy','date', 'yr_built','yr_renovated') #제거할 변수
num_vars <- setdiff(colnames(k_all), c(cat_vars, del_vars))  #del_var 제외 변수 추출

str(k_all)

## Classes 'data.table' and 'data.frame':   21501 obs. of  30 variables:
##  $ date             : chr  "20141013" "20150225" "20150218" "20140627" ...
##  $ price            : num  221900 180000 510000 257500 291850 ...
##  $ bedrooms         : int  3 2 3 3 3 3 2 3 3 5 ...
##  $ bathrooms        : num  1 1 2 2.25 1.5 2.5 1 1 1.75 2 ...
##  $ sqft_living      : int  1180 770 1680 1715 1060 3560 1160 1430 1370 1810 ...
##  $ sqft_lot         : int  5650 10000 8080 6819 9711 9796 6000 19901 9680 4850 ...
##  $ floors           : Factor w/ 6 levels "1","1.5","2",..: 1 1 1 3 1 1 1 2 1 2 ...
##  $ waterfront       : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ view             : Factor w/ 5 levels "0","1","2","3",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ condition        : Factor w/ 5 levels "1","2","3","4",..: 3 3 3 3 3 3 4 4 4 3 ...
##  $ grade            : Factor w/ 12 levels "1","3","4","5",..: 6 5 7 6 6 7 6 6 6 6 ...
##  $ sqft_above       : int  1180 770 1680 1715 1060 1860 860 1430 1370 1810 ...
##  $ sqft_basement    : int  0 0 0 0 0 1700 300 0 0 0 ...
##  $ yr_built         : int  1955 1933 1987 1995 1963 1965 1942 1927 1977 1900 ...
##  $ yr_renovated     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ zipcode          : Factor w/ 70 levels "98001","98002",..: 67 17 38 3 69 7 50 17 38 46 ...
##  $ lat              : num  47.5 47.7 47.6 47.3 47.4 ...
##  $ long             : num  -122 -122 -122 -122 -122 ...
##  $ sqft_living15    : int  1340 2720 1800 2238 1650 2210 1330 1780 1370 1360 ...
##  $ sqft_lot15       : int  5650 8062 7503 6819 9711 8925 6000 12697 10208 4850 ...
##  $ Yrbuy            : chr  "2014" "2015" "2015" "2014" ...
##  $ Mobuy            : chr  "10" "02" "02" "06" ...
##  $ Yrmbuy           : Factor w/ 13 levels "201405","201406",..: 6 10 10 2 9 12 1 1 6 11 ...
##  $ Remod            : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ Age              : num  59 82 28 19 52 50 72 87 37 115 ...
##  $ IsNew            : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ city             : Factor w/ 24 levels "Auburn","Bellevue",..: 21 11 20 9 21 2 21 11 20 21 ...
##  $ mecity           : Factor w/ 2 levels "0","1": 1 1 1 1 1 1 1 1 1 1 ...
##  $ living_divide_lot: num  0.209 0.077 0.208 0.252 0.109 ...
##  $ TotalRooms       : Factor w/ 55 levels "0","0.75","1",..: 14 10 18 19 16 20 10 14 17 26 ...
##  - attr(*, ".internal.selfref")=<externalptr>

# 수치형 변수 표준화
X_train_num <- k_all[!is.na(k_all$price), num_vars, with=F]
X_test_num <- k_all[is.na(k_all$price), num_vars, with=F]

mean.tr <- apply(X_train_num, 2, mean)
sd.tr <- apply(X_train_num, 2, sd)

X_train_num <- scale(X_train_num, center = mean.tr, scale = sd.tr)
X_test_num <- scale(X_test_num, center = mean.tr, scale = sd.tr)

X_train <- model.matrix(~.-1, data=cbind(X_train_num, k_all[!is.na(k_all$price), cat_vars, with=F]))
X_test <- model.matrix(~.-1, data = cbind(X_test_num, k_all[is.na(k_all$price), cat_vars, with=F]))
Y_train <- log(k_all[!is.na(k_all$price), price])

7 Modeling

##LASSO

RMSE_exp <- function (data, lev = NULL, model = NULL) {
  out <- sqrt(mean((exp(data$obs) - exp(data$pred))^2))
  names(out) <- "RMSE_exp"
  out
}

tic('LASSO')
set.seed(0418)
k_control <- trainControl(method = 'cv', number = 5, summaryFunction = RMSE_exp)
tuneGrid <- expand.grid(alpha = 1, lambda = c(0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1))
fit.lasso <- train(x = as.matrix(X_train), y= Y_train,
                   method = 'glmnet', 
                   metric = 'RMSE',
                   maximize = FALSE,
                   trControl = k_control,
                   tuneGrid = tuneGrid)

## Warning in load(system.file("models", "models.RData", package = "caret")):
## strings not representable in native encoding will be translated to UTF-8

## Warning in train.default(x = as.matrix(X_train), y = Y_train, method =
## "glmnet", : The metric "RMSE" was not in the result set. RMSE_exp will be
## used instead.

toc()

## LASSO: 6.28 sec elapsed

fit.lasso

## glmnet 
## 
## 15033 samples
##   199 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 12027, 12027, 12025, 12026, 12027 
## Resampling results across tuning parameters:
## 
##   lambda  RMSE_exp
##   1e-06   141953.8
##   1e-05   141953.8
##   1e-04   141963.2
##   1e-03   138149.0
##   1e-02   146931.0
##   1e-01   256207.5
## 
## Tuning parameter 'alpha' was held constant at a value of 1
## RMSE_exp was used to select the optimal model using the smallest value.
## The final values used for the model were alpha = 1 and lambda = 0.001.

fit.lasso$bestTune

##   alpha lambda
## 4     1  0.001

min(fit.lasso$results$RMSE_exp)

## [1] 138149

lasso.varimp <- varImp(fit.lasso, scale = F)
lasso.imp <- lasso.varimp$importance
lasso.importance <- data.frame(variable = rownames(lasso.imp), importance = lasso.imp$Overall) %>% 
  arrange((importance))
lasso.importance$variable <- factor(lasso.importance$variable, levels = lasso.importance$variable, labels = lasso.importance$variable)

num.vars.selected <- length(which(lasso.importance$importance!=0))
num.vars.not.selected <- length(which(lasso.importance$importance==0))
cat('Lasso uses', num.vars.selected, 'variables in its model, and did not select', num.vars.not.selected, 'variables')

## Lasso uses 156 variables in its model, and did not select 43 variables

lasso.importance[which(lasso.importance$importance!=0),] %>% 
  ggplot(aes(x=variable, y=importance, fill=variable)) + 
                            geom_bar(alpha=0.5, stat='identity') + 
                            coord_flip() + # 가로 barplot
                            theme_light() + theme(legend.position = "none")

as.character(lasso.importance$variable[which(lasso.importance$importance==0)])

##  [1] "sqft_basement"     "long"              "sqft_lot15"       
##  [4] "Yrmbuy201407"      "Yrmbuy201410"      "Yrmbuy201412"     
##  [7] "Yrmbuy201501"      "zipcode98003"      "zipcode98007"     
## [10] "zipcode98024"      "zipcode98027"      "zipcode98030"     
## [13] "zipcode98040"      "zipcode98042"      "zipcode98053"     
## [16] "zipcode98056"      "zipcode98072"      "zipcode98074"     
## [19] "cityBothell"       "cityCarnation"     "cityDuvall"       
## [22] "cityFall City"     "cityKenmore"       "cityKirkland"     
## [25] "cityMedina"        "cityMercer Island" "cityRenton"       
## [28] "condition3"        "grade3"            "grade8"           
## [31] "floors2.5"         "floors3.5"         "TotalRooms2.25"   
## [34] "TotalRooms4.25"    "TotalRooms6"       "TotalRooms6.75"   
## [37] "TotalRooms7.5"     "TotalRooms8.25"    "TotalRooms8.75"   
## [40] "TotalRooms11"      "TotalRooms12.5"    "TotalRooms13"     
## [43] "TotalRooms34.75"

predictions_lasso <- exp(predict(fit.lasso, X_test))
head(predictions_lasso)

##         1         2         3         4         5         6 
##  544987.2  506684.5 1542874.1  326338.8  320944.5  326151.1

submission_lasso <- read.csv('./kako 2nd/sample_submission.csv')
submission_lasso$price <- predictions_lasso
write.csv(submission_lasso, file = 'submission_lasso.csv', row.names = F)

7.1 XGBoost

tuneGrid <- expand.grid(
  max_depth = c(6, 60),  #default: 6
  subsample = c(0.8, 1), #default: 1
  colsample_bytree = c(0.9, 1) #default: 1
)

RMSE_exp <- function(preds, dtrain) {
  labels <- xgboost::getinfo(dtrain, 'label')
  err <- sqrt(mean((exp(labels) -exp(preds))^2))
  return(list(metric = 'RMSE_exp', value = err))
}

# Dmatrix로 testing & training data 분리
dtrain <- xgb.DMatrix(data = as.matrix(X_train), label = Y_train)
dtest <- xgb.DMatrix(data = as.matrix(X_test))
results <- list(val_rmse = rep(0, nrow(tuneGrid)),
                nrounds = rep(0, nrow(tuneGrid)))

for ( i in 1:nrow(tuneGrid)){
  params <- list(
    objective = 'reg:linear',
    metric = 'rmse',
    booster = 'gbtree',
    eta = 0.01, #default: 0.3
    gamma = 0,  #default: 0
    min_child_weight =1, #default: 1
    max_depth = tuneGrid[i, 'max_depth'],
    subsample = tuneGrid[i, 'subsample'],
    colsample_bytree = tuneGrid[i, 'colsample_bytree']
  )
}

** cross validation **

# tic('xgbcv')
xgbcv <- xgb.cv(params = params, 
                   data = dtrain, 
                   nrounds = 10000, 
                   nfold = 5,
                   feval = RMSE_exp,
                   print_every_n = 100,
                   early_stopping_rounds = 100,
                   maximize = F,
                   seed=4018)

## [1]  train-RMSE_exp:655419.825393+2921.701786    test-RMSE_exp:655323.559028+11656.376213 
## Multiple eval metrics are present. Will use test_RMSE_exp for early stopping.
## Will train until test_RMSE_exp hasn't improved in 100 rounds.
## 
## [101]    train-RMSE_exp:650634.685487+2935.851197    test-RMSE_exp:650542.222057+11731.543974 
## [201]    train-RMSE_exp:559037.710743+3050.720191    test-RMSE_exp:559319.689872+13214.710928 
## [301]    train-RMSE_exp:357677.052412+3181.334054    test-RMSE_exp:361539.386816+17473.688044 
## [401]    train-RMSE_exp:194696.650231+2615.220915    test-RMSE_exp:217386.020635+19694.453508 
## [501]    train-RMSE_exp:100271.107909+1482.049506    test-RMSE_exp:157179.871919+20502.009243 
## [601]    train-RMSE_exp:51427.714980+944.016269  test-RMSE_exp:136059.104656+19732.571760 
## [701]    train-RMSE_exp:27137.841107+693.215882  test-RMSE_exp:127777.868486+17605.990539 
## [801]    train-RMSE_exp:15022.846038+486.756401  test-RMSE_exp:124713.029052+16291.673003 
## [901]    train-RMSE_exp:8589.882900+323.347487   test-RMSE_exp:123428.183212+15604.328623 
## [1001]   train-RMSE_exp:5023.638203+204.781119   test-RMSE_exp:122859.244510+15110.679485 
## [1101]   train-RMSE_exp:2973.263161+135.975261   test-RMSE_exp:122574.095736+14779.306337 
## [1201]   train-RMSE_exp:1778.763823+80.046641    test-RMSE_exp:122427.498689+14580.411372 
## [1301]   train-RMSE_exp:1088.939046+48.068356    test-RMSE_exp:122348.590648+14457.837507 
## [1401]   train-RMSE_exp:698.005369+29.361926 test-RMSE_exp:122308.292041+14381.733724 
## [1501]   train-RMSE_exp:519.521226+12.239330 test-RMSE_exp:122283.269558+14345.479406 
## [1601]   train-RMSE_exp:466.419056+8.647863  test-RMSE_exp:122272.452031+14322.571500 
## [1701]   train-RMSE_exp:442.566749+9.345404  test-RMSE_exp:122266.234532+14309.839791 
## [1801]   train-RMSE_exp:440.676251+10.418822 test-RMSE_exp:122266.292226+14309.624724 
## Stopping. Best iteration:
## [1702]   train-RMSE_exp:442.445924+9.359117  test-RMSE_exp:122266.183711+14309.746564

# toc()
results[['val_rmse']][i] <- unlist(xgbcv$evaluation_log[xgbcv$best_iteration, 'test_RMSE_exp_mean'])
results[['nrounds']][i] <- xgbcv$best_iteration

min.index <- which.min(results[['val_rmse']])
tuneGrid[min.index,]

##   max_depth subsample colsample_bytree
## 1         6       0.8              0.9

cbind(tuneGrid, RMSE = unlist(results[['val_rmse']]))

##   max_depth subsample colsample_bytree     RMSE
## 1         6       0.8              0.9      0.0
## 2        60       0.8              0.9      0.0
## 3         6       1.0              0.9      0.0
## 4        60       1.0              0.9      0.0
## 5         6       0.8              1.0      0.0
## 6        60       0.8              1.0      0.0
## 7         6       1.0              1.0      0.0
## 8        60       1.0              1.0 122266.2

default_param <- list(objective = 'reg:linear',
                        booster = 'gbtree',
                        eta = 0.01,
                        gamma = 0,
                        min_child_weight = 1,
                        max_depth         = tuneGrid[min.index, "max_depth"],
                        subsample         = tuneGrid[min.index, "subsample"],
                        colsample_bytree  = tuneGrid[min.index, "colsample_bytree"]
                        )

fit.xgb <- xgb.train(data=dtrain,
                     params = default_param,
                     nrounds = results[['nrounds']][min.index],
                     seed = 4018)

predictions_xgb <- exp(predict(fit.xgb, dtest))
head(predictions_xgb)

## [1] 2.141793 2.094587 2.141793 2.094587 2.094587 2.104560

submission_xgb <- read.csv('./kako 2nd/sample_submission.csv')
submission_xgb$price <- predictions_xgb
write.csv(submission_xgb, file = 'submission_xgb.csv', row.names = F)

7.2 Ensemble

Lasso와 XGBoost의 결과값 앙상블

k_sub.avg <- data.frame(ID=k_test.labels, price = (2*predictions_xgb + predictions_lasso)/3)
head(k_sub.avg)

##      ID    price
## 1 15035 181663.8
## 2 15036 168896.2
## 3 15037 514292.8
## 4 15038 108781.0
## 5 15039 106982.9
## 6 15040 108718.4

write.csv(k_sub.avg, file = 'average.csv', row.names = F)

Seattle House price prediction with R

Maestro

2019년 5월 14일